Ede’s Zichten consumption

Introduction

Follow Ede on his journey to become emission-free :-)

It’s pretty easy. This document is being updated once a day (around noon) with the amount of cigarettes smoked the day before. The plot below is used to track progress.

The area shaded in light green is the amount of allowed cigarettes which will be reduced by one each month (starting on the 11th of each month). The dots are the actual cigarettes smoked (green - inside allowed range, red - ouside allowed range). The thin grey dashed trend line is a simple linear regression best fit. The blue line shows monthly averages. The brown bars at the bottom indicate when a new package of tobacco was opened.

Code

library(googlesheets4)
library(ggplot2)
library(data.table)
library(lubridate)
library(plotly)

# options(gargle_oauth_email = TRUE)
# gs4_auth(email = "tim.appelhans@gmail.com")
# gs4_auth_configure(api_key = Sys.getenv("GOOGLE_API_KEY"))
gs4_deauth()

sht = read_sheet(
  # "https://docs.google.com/spreadsheets/d/1UNUKMf1Zw5eryhTJLgDyp4nKmKwi_Udg_dik56dpWIA/edit#gid=0"
  # "https://docs.google.com/spreadsheets/d/1UNUKMf1Zw5eryhTJLgDyp4nKmKwi_Udg_dik56dpWIA/edit?usp=sharing"
  "https://docs.google.com/spreadsheets/d/1UNUKMf1Zw5eryhTJLgDyp4nKmKwi_Udg_dik56dpWIA/edit?usp=share_link"
)
sht = as.data.table(sht)
sht[, days := seq_along(n)]
sht[, week := lubridate::week(date)]
sht[, mnth := lubridate::month(date)]
sht[, month_ave := round(mean(n, na.rm = TRUE), 2), by = n_max]
sht[, tobacco := c(0, diff(tobacco))]


lm1 = lm(n ~ days, data = sht)
eta0 = round((0 - lm1$coefficients[1]) / lm1$coefficients[2], 0) - sum(!is.na(sht$n))
eta5 = round((5 - lm1$coefficients[1]) / lm1$coefficients[2], 0) - sum(!is.na(sht$n))
zero_date0 = Sys.Date() + eta0
zero_date5 = Sys.Date() + eta5

clr = ifelse(sht$n_max - sht$n >= 0, "#007600", "#760000")

p = ggplot(
  data = sht
  , mapping = aes(
    x = date
  )
) + 
  geom_ribbon(
    mapping = aes(
      ymin = 0
      , ymax = n_max
    )
    , fill = "#6c936c50"
  ) +
  geom_bar(
    mapping = aes(
      x = date
      , y = tobacco
    )
    , stat = "identity"
    , fill = "#5e2f0d"
  ) +
  geom_line(
    aes(x = date, y = month_ave)
    , colour = "cornflowerblue"
    , alpha = 0.6
  ) +
  geom_line(mapping = aes(y = n), colour = "grey50") +
  geom_point(mapping = aes(y = n, text = ifelse(is.na(comment), "", comment)), colour = clr) +
  geom_smooth(
    mapping = aes(
      x = date
      , y = n
    )
    , method = lm
    , colour = "grey40"
    , se = FALSE
    , lty = 2
    , lwd = 0.5
  ) +
  ylim(c(0, 18)) +
  scale_y_continuous(breaks = seq(0, 18, 2)) +
  ylab("# cigarettes smoked") +
  theme_minimal()

plotly::ggplotly(p)

Using the linear regression mentioned above, we can infer when Ede will be smoke-free.

• ETA (0 Zichten): 368 days from today, i.e. 2024-02-02
• ETA (5 Zichten): 144 days from today, i.e. 2023-06-23